home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / asg.com / DEMO.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-07-17  |  7.2 KB  |  227 lines
  1. {BlueBag and AtSayGet procedure demonstration.  Each new feature demonstrated
  2.  in the source code is followed by the word DEMO so you can examine how it is
  3.  used. Not all the procedures are demonstrated but there is a good representa-
  4.  tion. See ReadDemo.PAS for a demonstration of the full screen editor.}
  5.  
  6. PROGRAM Demo;
  7.  
  8. {$V-}
  9. USES
  10.  CRT,
  11.  AtSayGet,
  12.  BlueBag;
  13.  
  14. TYPE
  15.  PhoneType = STRING[14];
  16.  
  17. VAR
  18.  AllOK : BOOLEAN;
  19.  DS1,
  20.  DS2   : DateString;
  21.  Dt1,
  22.  Dt2   : Date;
  23.  BigDt : DelimitedDate;
  24.  Change: LONGINT;
  25.  Str10 : STRING[10];
  26.  AnyS  : STRING;
  27.  Doc   : TEXT;
  28.  Age   : WORD;
  29.  
  30. CONST
  31.  Cont  : BOOLEAN  =True;
  32.  Phone : PhoneType='(   )    -    ';
  33.  AR    : REAL     =0.0;
  34.  LI    : LONGINT  =0;
  35.  I     : INTEGER  =0;
  36.  W     : WORD     =0;
  37.  
  38. BEGIN
  39.  ClrScr;
  40.  AtSay(20, 5,'AtSayGet and BlueBag TPU Demo');  {DEMO}
  41.  ReverseVideo;  {DEMO}
  42.  GoToXY(22, 6); WRITE('Oh look -- Reverse video!'); DELAY(3000);
  43.  RestoreVideo;  {DEMO}
  44.  CursorOff;     {DEMO}
  45.  AtSay(22,10,'Heh...Where''s the cursor?'); Delay(3000);
  46.  CursorOn;      {DEMO}
  47.  SetCursor(0,StopScan);  {DEMO}
  48.  AtSay(19,11,'Isn''t this a bit over doing it?'); Delay(3000);
  49.  RestoreCursor; {DEMO}
  50.  GoToXY(1,20);
  51.  WAIT;          {DEMO}
  52.  OpenWindow(5,5,70,12,White,Red,2,' STRING ROUTINES '); {DEMO}
  53.  WRITELN;
  54.  WRITELN(' (The image below this window was just saved on the heap)');
  55.  WRITE(' '); WAIT; ClrScr;
  56.  WRITELN('Please enter a line of text in lower case & press Enter:');
  57.  READLN(AnyS);
  58.  WRITELN('This demonstrates the UpperCase Function -');
  59.  WRITELN(UpperCase(AnyS));         {DEMO}
  60.  WAIT; ClrScr;
  61.  WRITELN('After NoBlanks() takes care of your line it looks like this:');
  62.  NoBlanks(AnyS); {DEMO}
  63.  WRITELN(AnyS);
  64.  WAIT; WRITELN;
  65.  WRITELN('The Trim() Function also works but it''s hard to');
  66.  WRITELN('demonstrate visually. See line 104 for a demo.'); WAIT;
  67.  OpenWindow(1,1,50,22,Black,LightGray,32,' SCREEN TRICKS ');
  68.  WRITELN('Here goes DrawBox()!'); Wait;
  69.  DrawBox(1,4,47,19,1); Delay(500);   {DEMO}
  70.  DrawBox(5,2,22,12,2); Delay(500);
  71.  DrawBox(10,15,40,18,240); Delay(500);
  72.  DrawBox(15,5,45,20,219);
  73.  GoToXY(2,13); WAIT; ClrScr;
  74.  AnyS:='This big line of text will fill all the screen.';
  75.  FOR Change:=1 TO 20 DO WRITELN(AnyS);
  76.  WRITELN('Now to test the Clear() procedure...'); WAIT;
  77.  Clear(2,2,30,11);  {DEMO}
  78.  GoToXY(4,4); WRITE('Clear() works!');
  79.  GoToXY(4,5); WAIT;
  80.  OpenWindow(10,12,80,20,White+Blink,Blue,1,' AtSayGet PROCEDURES ');
  81.  DEC(TextAttr,Blink);
  82.  OrgAttr:=31; SayAttr:=23; GetAttr:=112; EndAttr:=31;  {DEMO}
  83.  WRITELN('The AtSayGet unit provides the functional equivalence of the');
  84.  WRITELN('dBase:   @ Line,Row SAY "prompt" GET <var> [PICTURE] [RANGE]');
  85.  WRITELN('command. A full range of editing keys are employed.  See the');
  86.  WRITELN('ATSAYGET.DOC file for details.');
  87.  AtSayGetBoolean(2,6,'Continue?',Cont);  {DEMO}
  88.  WRITELN;
  89.  IF NOT Cont THEN
  90.  BEGIN
  91.   WRITE(' I insist!'); Delay(2000);
  92.  END;
  93.  ClrScr; AnyS:='';
  94.  REPEAT
  95.   AtSay(2,1,'Do not leave this field blank, or else!'); {you won't ever finish}
  96.   AtSayGetStrLen(2,2,'What is your name?',AnyS,30); {DEMO}
  97.  UNTIL NOT IsBlank(AnyS);                           {DEMO}
  98.  GoToXY(2,1); ClrEol;
  99.  AtSayGetWord  (2,3,'What is your age? ',W,2);      {DEMO}
  100.  AtSayGetStrPic(2,5,'What is your phone',Phone,'(999) 999-9999');   {DEMO}
  101.  AtSayGetInt   (2,6,'Enter an Integer  ',I,5);      {DEMO}
  102.  I:=0; ClrScr;
  103.  {the following shows some of the ASGRange procedures}
  104.  WRITELN('O.K. ',TRIM(AnyS),', let''s not have any negative numbers!');  {DEMO}
  105.  AtSayGetIntRange(2,4,'What do you owe on your car?',I,6,0,MaxInt);      {DEMO}
  106.  AtSayGetLongIntRange(2,5,'What is owing on your house?',LI,7,0,250000); {DEMO}
  107.  AtSayGetRealRange(2,6,'What are your living costs? ',AR,10,2,500,5000); {DEMO}
  108.  WRITELN; WAIT;
  109.  OpenWindow(20,15,75,22,White,Black,240,' DEVICE FUNCTIONS ');
  110.  OrgAttr:=15; SayAttr:=7; GetAttr:=112; EndAttr:=15;
  111.  Cont:=True;
  112.  WHILE Cont DO
  113.  BEGIN
  114.   ClrScr; WRITELN;
  115.   FOR W:=0 TO 2 DO
  116.   BEGIN
  117.    WRITE(' Your printer #',W+1:2,' is ');
  118.    IF PrinterOnLine(W) THEN WRITELN('on-line.') ELSE WRITELN('NOT on-line.');
  119.    {DEMO ^}
  120.   END;
  121.   AtSayGetBoolean(2,6,'Try again?',Cont);
  122.  END;
  123.  ClrScr;
  124.  OpenWindow(12,3,68,18,White,Black,1,' DATE FEATURES ');
  125.  ClrScr; AllOK:=False;
  126.  Dt2:=SysDate;  {DEMO}
  127.  Ds2:=DateToDateString(Dt2);  {DEMO}
  128.  WRITELN(' Today is ',DayName[DayOfWeek(Dt2)],', ',MonthName[MonthOfYear(Dt2)],
  129.          ' ',COPY(Ds2,3,2),', ',COPY(Ds2,5,4));  {DEMO of 2 functions}
  130.  REPEAT
  131.   BigDt:='  /  /    ';
  132.   AtSayGetStrPic(2,2,'Enter Birth Day as Mo/Dy/Year:',BigDt,'99/99/9999');
  133.   WRITELN;
  134.   Ds1:=StripDateString(BigDt);  {DEMO}
  135.   Dt1:=DateStringToDate(Ds1);   {DEMO}
  136.   IF Dt1<>BadDate THEN AllOK:=True ELSE
  137.   BEGIN
  138.    WRITELN(' You entered an invalid date. Please try again.'); WAIT; CLEAR(1,2,48,4);
  139.   END;
  140.  UNTIL AllOK;
  141.  WRITELN(' You were born on a ',DayName[DayOfWeek(Dt1)]);
  142.  WRITELN(' Gosh, that was ',DaysBetween(Dt1,Dt2),' days ago!');
  143.  Age:=Trunc((Dt2-Dt1) / 365.25);
  144.  WRITE(' You were ',Age,' years old ');
  145.  WRITELN((Dt2-Dt1)-Trunc(Age*365.25),' days ago.'); Dt1:=0;
  146.  AtSayGetLongIntRange(2,7,'Enter some number of days hence: ',Dt1,6,0,999999);
  147.  WRITELN;
  148.  IncDate(Dt2,Dt1);  {DEMO}
  149.  Ds2:=DateToDateString(Dt2);
  150.  BigDt:=DelimitDateString(DS2);  {DEMO}
  151.  WRITELN(' The date that is ',Dt1,' days from now is ',BigDt);
  152.  WRITELN(' That will be a ',DayName[DayOfWeek(Dt2)],' in ',MonthName[MonthOfYear(Dt2)]);
  153.  WRITELN;
  154.  WRITELN(' These date routines are only usefull until ',
  155.           DelimitDateString(DateToDateString(3652499)));
  156.  WRITELN(' Sorry.'); WAIT;
  157.  CloseWindow; {Date Features}
  158.  AnyS:='BLUEBAG.DOC '; Cont:=True;
  159.  WHILE Cont DO
  160.  BEGIN
  161.   ClrScr;
  162.   AtSayGetStrLen(2,2,'Enter a file name',AnyS,12); GoToXY(2,4);
  163.   WRITE(Trim(AnyS));
  164.   IF OnFile(AnyS) THEN WRITELN(' is on file.') ELSE WRITELN(' is NOT on file.');
  165.   {DEMO ^}
  166.   AtSayGetBoolean(2,5,'Try again?',Cont);
  167.  END;
  168.  ClrScr; Cont:=True;
  169.  AtSayGetBoolean(2,3,'Read the documentation now?',Cont); WRITELN;
  170.  IF Cont THEN
  171.  BEGIN
  172.   IF OnFile('BLUEBAG.DOC') OR OnFile('ATSAYGET.DOC') THEN
  173.   BEGIN
  174.    OpenWindow(1,1,80,24,LightGray,Black,1,' DOCUMENTATION ');
  175.    IF OnFile('BLUEBAG.DOC') THEN
  176.    BEGIN
  177.     ASSIGN(Doc,'BLUEBAG.DOC'); RESET(Doc); I:=1;
  178.     WHILE NOT EOF(Doc) DO
  179.     BEGIN
  180.      Readln(Doc,AnyS); WRITELN(AnyS); INC(I);
  181.      IF I=21 THEN
  182.      BEGIN
  183.       WAIT; GoToXY(1,WhereY); ClrEol; I:=1;
  184.      END;
  185.     END;
  186.     CLOSE(Doc);  WAIT;  ClrScr;
  187.    END
  188.    ELSE
  189.    BEGIN
  190.     WRITELN('BLUEBAG.DOC IS NOT ON FILE.'); WAIT;
  191.    END;
  192.    ClrScr;
  193.    IF OnFile('ATSAYGET.DOC') THEN
  194.    BEGIN
  195.     ASSIGN(Doc,'ATSAYGET.DOC'); RESET(Doc); I:=1;
  196.     WHILE NOT EOF(Doc) DO
  197.     BEGIN
  198.      Readln(Doc,AnyS); WRITELN(AnyS); INC(I);
  199.      IF I=21 THEN
  200.      BEGIN
  201.       WAIT; GoToXY(1,WhereY); ClrEol; I:=1;
  202.      END;
  203.     END;
  204.     CLOSE(Doc);  WAIT;  ClrScr;
  205.    END
  206.    ELSE
  207.    BEGIN
  208.     WRITELN('ATSAYGET.DOC IS NOT ON FILE.'); WAIT;
  209.    END;
  210.    CloseWindow;
  211.   END
  212.   ELSE
  213.   BEGIN
  214.    WRITELN('Rats, both document files are missing!'); Wait;
  215.   END;
  216.  END;
  217.  CloseWindow; {DEMO}
  218.  Delay(500);
  219.  CloseWindow; Delay(500);
  220.  CloseWindow; Delay(500);
  221.  CloseWindow;
  222.  IF IsColor THEN TextAttr:=30 ELSE TextAttr:=7;  {DEMO}
  223.  SayAttr:=TextAttr;
  224.  AtSay(1,24,'Well, how''s that?');
  225. END.
  226.  
  227.